unit md5;

interface

type
  ULONG_PTR = Longword;
  HCRYPTPROV = ULONG_PTR;
  HCRYPTHASH = ULONG_PTR;

  TMongoMd5Byte = Byte;
  PMongoMd5Byte = ^TMongoMd5Byte;
  TMongoMd5Word = Longword;
  PMongoMd5Word = ^TMongoMd5Word;

  TMongoMd5Digest = record
  case ByByte: Boolean of
    True: (
      bytes: array[0..15] of TMongoMd5Byte;
    );
    False: (
      words: array[0..3] of TMongoMd5Word;
    );
  end;
  PMongoMd5Digest = ^TMongoMd5Digest;

  TMongoMd5State = record
    CryptProv: HCRYPTPROV;
    CryptHash: HCRYPTHASH;
  end;

// Initialize the algorithm
procedure mongo_md5_init(var pms: TMongoMd5State);

// Append a string to the message
procedure mongo_md5_append(var pms: TMongoMd5State; data: PMongoMd5Byte; nbytes: Integer);

// Finish the message and return the digest
procedure mongo_md5_finish(var pms: TMongoMd5State; digest: PMongoMd5Digest);

implementation

uses
  SysUtils;

type
  HCRYPTKEY = ULONG_PTR;
  LPCWSTR = PWideChar;
  DWORD = Longword;
  BOOL = LongBool;
  ALG_ID = Cardinal;
  LPBYTE = ^Byte;

const
  advapi32 = 'advapi32.dll';

  PROV_RSA_FULL = 1;

  CRYPT_NEWKEYSET = $00000008;
  CRYPT_SILENT    = $00000040;

  ALG_CLASS_HASH = 4 shl 13;
  ALG_TYPE_ANY   = 0;
  ALG_SID_MD5    = 3;
  CALG_MD5       = ALG_CLASS_HASH or ALG_TYPE_ANY or ALG_SID_MD5;

  HP_HASHVAL       = $0002; // Hash value

function CryptAcquireContext(var phProv: HCRYPTPROV; pszContainer: LPCWSTR;
  pszProvider: LPCWSTR; dwProvType: DWORD; dwFlags: DWORD): BOOL; stdcall;
  external advapi32 name 'CryptAcquireContextW';
function CryptCreateHash(hProv: HCRYPTPROV; Algid: ALG_ID; hKey: HCRYPTKEY;
  dwFlags: DWORD; var phHash: HCRYPTHASH): BOOL; stdcall;
  external advapi32 name 'CryptCreateHash';
function CryptHashData(hHash: HCRYPTHASH; pbData: LPBYTE; dwDataLen, dwFlags: DWORD): BOOL; stdcall;
  external advapi32 name 'CryptHashData';
function CryptGetHashParam(hHash: HCRYPTHASH; dwParam: DWORD; pbData: LPBYTE;
  var pdwDataLen: DWORD; dwFlags: DWORD): BOOL; stdcall;
  external advapi32 name 'CryptGetHashParam';
function CryptDestroyHash(hHash: HCRYPTHASH): BOOL; stdcall;
  external advapi32 name 'CryptDestroyHash';
function CryptReleaseContext(hProv: HCRYPTPROV; dwFlags: DWORD): BOOL; stdcall;
  external advapi32 name 'CryptReleaseContext';

procedure mongo_md5_init(var pms: TMongoMd5State);
begin
  if not CryptAcquireContext(pms.CryptProv, '{EB0A5F84-0648-4442-A3C8-C864D09C3505}', nil, PROV_RSA_FULL,
           CRYPT_SILENT) then
    if not CryptAcquireContext(pms.CryptProv, '{EB0A5F84-0648-4442-A3C8-C864D09C3505}', nil, PROV_RSA_FULL,
             CRYPT_SILENT or CRYPT_NEWKEYSET) then
      RaiseLastOSError;
  if not CryptCreateHash(pms.CryptProv, CALG_MD5, 0, 0, pms.CryptHash) then
      RaiseLastOSError;
end;

procedure mongo_md5_append(var pms: TMongoMd5State; data: PMongoMd5Byte; nbytes: Integer);
begin
  if not CryptHashData(pms.CryptHash, LPBYTE(data), nbytes, 0) then
    RaiseLastOSError;
end;

procedure mongo_md5_finish(var pms: TMongoMd5State; digest: PMongoMd5Digest);
var
  DataLen: DWORD;
begin
  DataLen := 16;
  if not CryptGetHashParam(pms.CryptHash, HP_HASHVAL, LPBYTE(digest), DataLen, 0) then
    RaiseLastOSError;
  if pms.CryptHash <> 0 then CryptDestroyHash(pms.CryptHash);
  if pms.CryptProv <> 0 then CryptReleaseContext(pms.CryptProv, 0);
end;

end.
